home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / onenssrc / part3.pas < prev    next >
Pascal/Delphi Source File  |  1996-01-17  |  6KB  |  325 lines
  1. unit Part3;
  2.  
  3. interface
  4.  
  5. uses
  6.     zipvga, liktwk, crt, oneres, fastsine;
  7.  
  8.     procedure Run;
  9.  
  10. implementation
  11.  
  12. const
  13.     firstframe = 2048;
  14.     lastframe1 = firstframe + 1024;
  15.     lastframe2 = lastframe1 + 1024 - 512;
  16.  
  17. var
  18.     i, j, k, d : word;
  19.     swerve : integer;
  20.     aswerve : word;
  21.     f : longint;
  22.     scr, tab, pic : ^screen2;
  23.     scrs, tabs, pics : word;
  24.  
  25.     procedure MakePic;
  26.  
  27.     var
  28.         i, j : word;
  29.  
  30.     begin
  31.         for i := 0 to 65535 do
  32.             vscr2[i] := random(128) + random(128) + 1;
  33.         pic^ := vscr2;
  34.         {for i := 0 to 65535 do
  35.             vscr2[i] := (pic^[i+1] + pic^[i-1] + pic^[i+256] + pic^[i-256]) div 8
  36.                     + (pic^[i+321] + pic^[i - 321] + pic^[i+319] - pic^[i-319]) div 8;}
  37.         for j := 0 to 2 do
  38.          begin
  39.             for i := 0 to 65535 do
  40.                 vscr2[i] := (pic^[i+1] + pic^[i] + pic^[i+320] + pic^[i+321]) div 4 + random(4) - random(4);
  41.             pic^ := vscr2;
  42.          end;
  43.     end;
  44.  
  45.     procedure MakeTabs;
  46.  
  47.     var
  48.         dx, dy : integer;
  49.         z, d : longint;
  50.  
  51.     begin
  52.         init60hz256256256c;
  53.         brightness (63,0);
  54.         {if not loadpic2('thing.tab', tab^) then}
  55.          begin
  56.             for dx := -128 to 127 do
  57.              begin
  58.                 for dy := -64 to 63 do
  59.                  begin
  60.                     if dx = 0 then
  61.                      begin
  62.                         if dy > 0 then
  63.                             tab^[(dy + 64)*256 + dx + 128] := 64
  64.                         else
  65.                             tab^[(dy + 64)*256 + dx + 128] := 192;
  66.                      end
  67.                     else
  68.                         tab^[(dy + 64)*256 + dx + 128] := round(arctan(dy/dx)*256/2/pi);
  69.                     if dx < 0 then
  70.                         tab^[(dy + 64)*256 + dx + 128] := tab^[(dy + 64)*256 + dx + 128];
  71.                  end;
  72.                 vscr2 := tab^;
  73.              end;
  74.  
  75.             for dx := -128 to 127 do
  76.              begin
  77.                 for dy := -64 to 63 do
  78.                  begin
  79.                     tab^[(dy + 64)*256 + 128*256 + dx + 128] := (tab^[(dy + 64)*256 + dx + 128] + 128) and 255;
  80.                  end;
  81.                 vscr2 := tab^;
  82.              end;
  83.  
  84.             savepic2 ('thing.tab', tab^);
  85.          end;
  86.  
  87.         vscr2 := tab^;
  88.         initvga;
  89.     end;
  90.  
  91. procedure Run;
  92.  
  93. begin
  94.     {new (scr);}
  95.     scr := @vscr2;
  96.     new (tab);
  97.     new (pic);
  98.     scrs := seg(scr^);
  99.     tabs := seg(tab^);
  100.     pics := seg(pic^);
  101.  
  102.     initb;
  103.     initi;
  104.     initvga;
  105.  
  106.     brightness (0, 0);
  107.  
  108.     {MakePic;}
  109.     {readkey;}
  110.  
  111.     {MakeTabs;
  112.     readkey;}
  113.     fetch ('tunnel.tab');
  114.     blockread (lf, tab^, 65535);
  115.  
  116.     fetch ('voxel.mp');
  117.     blockread (lf, pic^, 65535);
  118.  
  119.     filldword (vscr, 16384, 0);
  120.  
  121.     j := 0;
  122.     k := 0;
  123.     f := 0;
  124.     swerve := 0;
  125.     repeat
  126.         getpos;
  127.         f := track*256 + row*4;
  128.         if f < firstframe + 256 then
  129.             brightness ((f - firstframe) div 4, 0)
  130.         else if f > lastframe1 - 64 then
  131.             brightness ((lastframe1 - f), 0);
  132.         {for i := 0 to 32767 do
  133.          begin
  134.             d := tab^[i+32768];
  135.             vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
  136.          end;}
  137.  
  138.         {retrace;}
  139.         {setrgb (0, 31, 0, 0);}
  140.  
  141.         if f >= firstframe + 64 then
  142.             inc (swerve);
  143.         {swerve := ssin(f);}
  144.         aswerve := abs(swerve);
  145.  
  146.         {repeat until sync;
  147.         sync := false;}
  148.         if trapretrace then
  149.             retrace;
  150.         asm
  151.             mov ax, k
  152.             mov ah, al
  153.             xor al, al
  154.             mov si, ax
  155.             add si, j
  156.  
  157.             mov cx, [aswerve]
  158.  
  159.             xor di, di
  160.             cmp [swerve], 0
  161.             jg @AtEnd
  162.             xor al, al
  163.             mov dx, [scrs]
  164.             mov es, dx
  165.             add di, 50*320
  166.             rep stosb
  167.             sub di, 50*320
  168.          @AtEnd:
  169.  
  170.             mov cx, 32000
  171.             sub cx, [aswerve]
  172.          @Loop:
  173.             mov dx, [tabs]
  174.             mov es, dx
  175.  
  176.             add di, [swerve]
  177.             mov bh, es:[di]
  178.             sub di, [swerve]
  179.             mov bl, es:[di+32768]
  180.  
  181.             mov dx, [pics]
  182.             mov es, dx
  183.  
  184.             mov al, es:[bx+si]
  185.             mov ah, 255
  186.             sub ah, bl
  187.             mul ah
  188.  
  189.             mov dx, 0A000h {[scrs]}
  190.             mov es, dx
  191.  
  192.             mov es:[di+50*320], ah
  193.  
  194.             inc di
  195.             dec cx
  196.             jnz @Loop
  197.  
  198.             cmp [swerve], 0
  199.             jl @AtBeginning
  200.             add di, 50*320
  201.             mov cx, [aswerve]
  202.             xor al, al
  203.             rep stosb
  204.          @AtBeginning:
  205.         end;
  206.         {setrgb (0, 0, 0, 0);}
  207.  
  208.         {for i := 0 to 15 do
  209.             inc (pic^[j + k*256], random(64));}
  210.  
  211.         inc (j, 2);
  212.         inc (k, 1);
  213.     until keypressed or (f >= lastframe1);
  214.  
  215.     if keypressed then
  216.         readkey;
  217.  
  218.     init60hz256256256c;
  219.  
  220.     fetch ('thing.tab');
  221.     blockread (lf, tab^, 65535);
  222.  
  223.     fetch ('voxel.mt');
  224.     blockread (lf, pic^, 65535);
  225.  
  226.     filldword (vscr, 16384, 0);
  227.  
  228.     j := 0;
  229.     k := 0;
  230.     f := 0;
  231.     repeat
  232.         getpos;
  233.         f := track*256 + row*4;
  234.         if f < lastframe1 + 256 then
  235.             brightness ((f - lastframe1) div 4, 0)
  236.         else if f > lastframe2 - 64 then
  237.             brightness ((lastframe2 - f), 0);
  238.         {for i := 0 to 32767 do
  239.          begin
  240.             d := tab^[i+32768];
  241.             vscr2[i+63*256] := pic^[d*256 + tab^[i] + j*3*256 + j]*(255 - d) div 256;
  242.          end;}
  243.  
  244.         {retrace;}
  245.         {setrgb (0, 31, 0, 0);}
  246.  
  247.         {swerve := swerve + ssin(f) div 16;}
  248.         swerve := (ssin(f*4) div 16 + scos(f*3 + 10) div 8)*256 + (ssin(f*5 + 15) div 8 + scos(f*6 + 20) div 16);
  249.         aswerve := abs(swerve);
  250.  
  251.         {repeat until sync;
  252.         sync := false;}
  253.  
  254.         if trapretrace then
  255.             retrace;
  256.         asm
  257.             mov ax, k
  258.             mov ah, al
  259.             xor al, al
  260.             mov si, ax
  261.             add si, j
  262.  
  263.             mov cx, [aswerve]
  264.  
  265.             xor di, di
  266.             {cmp [swerve], 0
  267.             jg @AtEnd}
  268.             xor al, al
  269.             mov dx, [scrs]
  270.             mov es, dx
  271.             add di, 63*256
  272.             rep stosb
  273.             sub di, 63*256
  274.          @AtEnd:
  275.  
  276.             mov cx, 32768
  277.             sub cx, [aswerve]
  278.          @Loop:
  279.             mov dx, [tabs]
  280.             mov es, dx
  281.  
  282.             mov bh, es:[di]
  283.             add di, [swerve]
  284.             mov bl, es:[di+32768]
  285.             sub di, [swerve]
  286.  
  287.             mov dx, [pics]
  288.             mov es, dx
  289.  
  290.             mov al, es:[bx+si]
  291.             {mov ah, 255
  292.             sub ah, bl
  293.             mul ah}
  294.  
  295.             mov dx, 0A000h {[scrs]}
  296.             mov es, dx
  297.  
  298.             mov es:[di+63*256], al
  299.  
  300.             inc di
  301.             dec cx
  302.             jnz @Loop
  303.  
  304.             cmp [swerve], 0
  305.             jl @AtBeginning
  306.             add di, 63*256
  307.             mov cx, [aswerve]
  308.             xor al, al
  309.             rep stosb
  310.          @AtBeginning:
  311.         end;
  312.         {setrgb (0, 0, 0, 0);}
  313.  
  314.         {for i := 0 to 15 do
  315.             inc (pic^[j + k*256], random(64));}
  316.  
  317.         inc (j, 2);
  318.         inc (k, 1);
  319.     until keypressed or (f >= lastframe2);
  320.  
  321.     dispose (tab);
  322.     dispose (pic);
  323. end;
  324.  
  325. end.